home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pasprog.EXE / TAKVIMTP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-09-24  |  4.3 KB  |  171 lines
  1. Unit Takvimtp;
  2. Interface
  3. Uses Crt,Dos;
  4. Const
  5.    Count:Array[1..12] Of Byte=(31,28,31,30,31,30,31,31,30,31,30,31);
  6.    Month:Array[1..12] Of String[7]=('Ocak   ','₧ubat  ','Mart   ','Nisan  '
  7.                                    ,'Mayìs  ','Haziran','Temmuz ','Agustos'
  8.                                    ,'Eylül  ','Ekim   ','Kasìm  ','Aralìk ');
  9. Type
  10.    Callendar = ^Cal;
  11.    Cal = Object
  12.          Day :Word;
  13.          Mon :Word;
  14.          Yea :Word;
  15.          DoW :Word;
  16.          Ox  :Integer;
  17.          Oy  :Integer;
  18.          Save:Array[1..4000] of Byte;
  19.          Constructor Init(X,Y:Integer);
  20.          Procedure   SetMonth(M:Integer);
  21.          Procedure   SetDay(D:Integer);
  22.          Procedure   Page;Virtual;
  23.          Procedure   Mover(Mx,My:Integer);
  24.          Procedure   Show;Virtual;
  25.          Procedure   ExitMessage;Virtual;
  26.          Function    Reader:Word;
  27.          Procedure   HandleEvent(Key:Word);Virtual;
  28.          Destructor  Done;
  29.    End;
  30. Var
  31.    XX,YY:Integer;
  32. Implementation
  33. function Segment:word;
  34. begin
  35.    if (mem[0:$0410] and $30)=$30 then segment:=$b000
  36.                                  else segment:=$b800;
  37. end;
  38. procedure HideCursor;Assembler;
  39. Asm
  40.    Mov Ax,0100h
  41.    Mov Cx,1f00h
  42.    Int 10h
  43. end;
  44. procedure StdCursor;Assembler;
  45. Asm
  46.    Mov Ax,0100h
  47.    Mov Cx,1e1fh
  48.    Int 10h
  49. end;
  50. Constructor Cal.Init(X,Y:Integer);
  51. Begin
  52.    Ox:=X;
  53.    Oy:=Y;
  54.    xx:=WhereX;
  55.    yy:=WhereY;
  56.    Move(Mem[Segment:0],Save[1],4000);
  57.    GetDate(Yea,Mon,Day,DoW);
  58.    HideCursor;
  59.    Show;
  60. End;
  61. Procedure Cal.SetMonth(M:Integer);
  62. Begin
  63.    Mon:=Mon+M;
  64.    If Mon<1 Then Begin Mon:=12; Yea:=Yea-1; End;
  65.    If Mon>12 Then Begin Mon:=1; Yea:=Yea+1; End;
  66.    Show;
  67. End;
  68. Procedure Cal.SetDay(D:Integer);
  69. Begin
  70.    Day:=Day+D;
  71.    If Day<1 Then Begin Mon:=Mon-1; Day:=Count[Mon]; End;
  72.    If Day>Count[Mon] Then Begin Mon:=Mon+1; Day:=1 End;
  73.    Show;
  74. End;
  75. Procedure Cal.Page;
  76. Begin
  77.    Move(Save,Mem[Segment:0],4000);
  78.    TextColor(14);
  79.    TextBackGround(1);
  80.    GotoXY(Ox,Oy);   Writeln('╔[■]════════════════════════╗');
  81.    GotoXY(Ox,Oy+1); Writeln('║                           ║');
  82.    GotoXY(Ox,Oy+2); Writeln('╠═══╦═══╦═══╦═══╦═══╦═══╦═══╣');
  83.    GotoXY(Ox,Oy+3); Writeln('║Pzr║Pts║Sal║Çrƒ║Prƒ║Cum║Cts║');
  84.    GotoXY(Ox,Oy+4); Writeln('╠═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  85.    GotoXY(Ox,Oy+5); Writeln('║   ║   ║   ║   ║   ║   ║   ║');
  86.    GotoXY(Ox,Oy+6); Writeln('║   ║   ║   ║   ║   ║   ║   ║');
  87.    GotoXY(Ox,Oy+7); Writeln('║   ║   ║   ║   ║   ║   ║   ║');
  88.    GotoXY(Ox,Oy+8); Writeln('║   ║   ║   ║   ║   ║   ║   ║');
  89.    GotoXY(Ox,Oy+9); Writeln('║   ║   ║   ║   ║   ║   ║   ║');
  90.    GotoXY(Ox,Oy+10);Writeln('║   ║   ║   ║   ║   ║   ║   ║');
  91.    GotoXY(Ox,Oy+11);Writeln('╚═══╩═══╩═══╩═══╩═══╩═══╩═══╝');
  92. End;
  93. Procedure Cal.Mover(Mx,My:Integer);
  94. Begin
  95.    Ox:=Mx+Ox;
  96.    Oy:=My+Oy;
  97.    If Ox<=0 Then Ox:=50 Else If Ox>50 then Ox:=1;
  98.    If Oy<=0 Then Oy:=13 Else If Oy>13 then Oy:=1;
  99.    Show;
  100. End;
  101. Procedure Cal.Show;
  102. Var
  103.    AKey     : Word;
  104.    Sx,Sy,Nx : Integer;
  105.    Day1,DoW1: Word;
  106. Begin
  107.    Page;
  108.    GotoXY(Ox+8,Oy+1);
  109.    Write(Month[Mon],' ',Yea);
  110.    Sy:=Oy+5;
  111.    SetDate(Yea,Mon,1);
  112.    GetDate(Yea,Mon,Day1,DoW1);
  113.    SetDate(Yea,Mon,Day);
  114.    If (Mon=2) And (Yea Mod 4=0) Then Count[2]:=29;
  115.    Sx:=Ox+1+Dow1*4;
  116.    For Nx:=1 To Count[Mon] Do
  117.    Begin
  118.       If Day=Nx Then TextColor(14+16);
  119.       GotoXY(Sx,Sy);
  120.       Write(Nx);
  121.       If Day=Nx Then TextColor(14);
  122.       Sx:=Sx+4;
  123.       If Sx>=Ox+28 Then
  124.       Begin
  125.          Sy:=Sy+1;
  126.          Sx:=Ox+1;
  127.       End;
  128.    End;
  129.    Repeat
  130.       AKey:=Reader;
  131.       HandleEvent(AKey);
  132.    Until 1=2;
  133. End;
  134. Function Cal.Reader:Word;
  135. Var
  136.    Key : Char;
  137. Begin
  138.    Key:=ReadKey;
  139.    If (Key=#0) And KeyPressed Then
  140.    Begin
  141.       Key:=ReadKey;
  142.       Reader:=Ord(Key) Shl 8;
  143.    End Else Reader:=Ord(Key);
  144. End;
  145. Procedure Cal.HandleEvent(Key:Word);
  146. Begin
  147.      Case Key Of
  148.           20736:SetMonth(-1);
  149.           18688:SetMonth(1);
  150.           45   :SetDay(-1);
  151.           43   :SetDay(1);
  152.           19712:Mover(1,0) ;
  153.           19200:Mover(-1,0);
  154.           18432:Mover(0,-1);
  155.           20480:Mover(0,1) ;
  156.           27   :Done;
  157.      End;
  158. End;
  159. Procedure Cal.ExitMessage;
  160. Begin
  161.    GotoXY(xx,yy);ClrEol;
  162.    Writeln('TurboSoft Callendar by Murat AKSARAY');
  163. End;
  164. Destructor Cal.Done;
  165. Begin
  166.    Move(Save,Mem[Segment:0],4000);
  167.    ExitMessage;
  168.    StdCursor;
  169.    Halt;
  170. End;
  171. End.